home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 6
/
FM Towns Free Software Collection 6.iso
/
t_os
/
yosig2
/
yosig2.bas
next >
Wrap
BASIC Source File
|
1993-07-08
|
12KB
|
390 lines
10 COLOR ,,,4
20 DIM X(101,181),Y(101,181),Z(101,181)
30 CONSOLE 0,25,0
40 FOR L = 1 TO 10
50 KEY L,"" 'key clear
60 NEXT
70 '
80 COLOR 7,0,7
90 P = 1 'デフォルト
100 N = 4 'デフォルト
110 π = ATN(1)*4*2 'ラジアン設定
120 CLS
130 LOCATE 9,24
140 INPUT "Japanese or English (J/E)? >",IN$
150 '
160 IF IN$ = "J" OR IN$ = "j" OR IN$ = "E" OR IN$ = "e" THEN 170 ELSE 120
170 IF IN$ = "J" OR IN$ = "j" THEN J = 1:RESTORE *JAPANESE ELSE GOTO 180
180 '
190 CLS
200 LOCATE 0,24
210 '
220 SYMBOL (13*8*(L-1),25*16+54),"PF"+STR$(L)+"-",1,1,4
230 READ A$
231 COLOR 7
240 IF A$ = "Eom" THEN 270
250 IF LEFT$(A$,1) = "*" THEN COLOR 3
251 PRINT A$
260 GOTO 230
270 '
280 READ K_KOSU
290 FOR L = 1 TO K_KOSU
300 READ K$(L) 'PF key 初期設定
310 KEY L,K$(L)
320 NEXT
330 GOSUB *PF_KEYS
340 '
350 FOR L=1 TO 2
360 READ SUBM$(L)
370 NEXT
380 '
390 READ I
410 FOR L = 1 TO I
420 READ QUES$(L) '質問設定
430 NEXT
431 '
432 D$=INPUT$(1) 'キー待ち
440 '
450 CLS 4
460 '
470 *MAIN
480 '
490 CLS 4
500 LOCATE 3,23
510 PRINT QUES$(1);
520 INPUT "",CM$
530 IF CM$ = "" THEN L = L1:GOTO 600
540 '
550 FOR L = 1 TO K_KOSU
560 IF CM$ = K$(L) THEN 590
570 NEXT
580 GOTO *MAIN
590 '
600 L1 = L:ON L GOSUB *DRAW,*SPIN,*CHANGE,*SAVE,*RESET,*END
610 GOTO *MAIN
620 '
630 *DRAW
640 ERASE X,Y,Z
641 XYZ$=""
650 CLS
660 GOSUB *PF_KEYS
670 '
680 FOR C = 1 TO 7
690 SYMBOL (500,40+C*36),STR$(C)+" ■",1,1,C 'カラーバー作製
700 NEXT
710 PRINT
720 '
730 LOCATE 3,22
740 PRINT QUES$(2); : INPUT "",P$
750 IF NOT P$ = "" THEN P = VAL(P$)
760 IF P<0 OR P>7 THEN BEEP : GOTO 720
770 '
780 LOCATE 6,23
790 PRINT QUES$(3); : INPUT "",N$
800 IF NOT N$ = "" THEN N = VAL(N$)
810 IF N<1 THEN BEEP : GOTO 780
820 IF N>50 THEN BEEP : GOTO 780
830 '
840 DIM X(N+1,181),Y(N+1,181),Z(N+1,181)
850 '
860 CLS 4
870 SYMBOL (400,360),SUBM$(1)+STR$(N),1,1,7 '何角形か表示
880 '
890 FOR L = 1 TO N
900 X(L,1) = 200+200*COS(π/N*L) : X(L+1,1) = 200+200*COS(π/N*(L+1))
910 Y(L,1) = 200+200*SIN(π/N*L) : Y(L+1,1) = 200+200*SIN(π/N*(L+1))
920 Z(L,1) = 200 : Z(L+1,1) = 200
930 NEXT
940 '
950 FOR I = 1 TO N
960 FOR L = 1 TO N
970 LINE (X(I,1),Y(I,1))-(X(L,1),Y(L,1)),PSET,P '対角線を細く
980 '
990 'DEF PEN 0,2
1000 LINE (X(L,1),Y(L,1))-(X(L+1,1),Y(L+1,1)),PSET,7'外枠を太く
1010 'DEF PEN 0,1
1020 '
1030 IF INKEY$ = CHR$(27) THEN 1070 'ESCキーを押した時
1040 NEXT
1050 NEXT
1060 '
1070 BEEP
1080 '
1090 RETURN
1100 '
1110 *SPIN
1120 CLS
1130 GOSUB *PF_KEYS
1140 '
1150 LOCATE 3,22 : PRINT QUES$(4);
1160 INPUT "",ANG$
1170 IF ANG$ = "" THEN ANG = VAL(ANG$)
1180 ANG = VAL(ANG$)
1190 IF 1>ANG OR ANG>360 THEN BEEP : CLS 4 : GOTO 1150
1200 '
1210 LOCATE 3,23 : PRINT QUES$(5);
1220 INPUT "",FRAME$
1230 IF FRAME$ = "" THEN FRAME = VAL(FRAME$)
1240 FRAME = VAL(FRAME$)
1250 IF 1>FRAME OR FRAME>360 THEN BEEP : CLS 4 : GOTO 1210
1260 '
1270 FOR J=1 TO FRAME
1280 FOR L = 1 TO N+1
1290 θ = ANG/FRAME
1300 J1 = J+1
1310 'Z(L,J) = 200
1320 GOSUB *Y_CNV
1330 NEXT
1340 NEXT
1350 '
1360 FOR J=1 TO FRAME
1370 FOR I = 1 TO N
1380 FOR L = 1 TO N
1390 LINE (X(I,J),Y(I,J))-(X(L,J),Y(L,J)),PSET,P '対角線を細く
1400 '
1410 'DEF PEN 0,2
1420 LINE (X(L,J),Y(L,J))-(X(L+1,J),Y(L+1,J)),PSET,7 '枠組みを太く
1430 'DEF PEN 0,1
1440 '
1450 IF INKEY$ = CHR$(27) THEN 1500 'ESCキーを押した時
1460 NEXT
1470 NEXT
1480 NEXT
1490 '
1500 BEEP
1510 '
1520 RETURN
1530 '
1540 *CHANGE
1550 CLS
1560 GOSUB *PF_KEYS
1570 '
1580 LOCATE 3,22 : PRINT QUES$(6);
1590 INPUT "",F$
1600 IF F$="" THEN F$=F1$
1610 IF F$ = "x" OR F$ = "y" OR F$ = "z" THEN 1660
1620 IF F$ = "X" OR F$ = "Y" OR F$ = "Z" THEN 1660
1630 GOTO *CHANGE
1640 '
1650 '
1660 IF F$ = "x" OR F$ = "y" OR F$ = "z" THEN F$ = CHR$(ASC(F$)-32)
1670 FR = ASC(F$)-87 : F1$=F$ '軸のデーターを数値に変換
1680 '
1690 LOCATE 3,23 : PRINT QUES$(7);
1700 INPUT "",ANG1$
1710 IF ANG1$="" THEN ANG1=VAL(ANG1$)
1720 ANG1 = VAL(ANG1$)
1730 IF 1>ANG1 OR ANG1>360 THEN BEEP : CLS 4 : GOTO 1690
1740 '
1741 ANG1=ANG1-((NOT ANG1>360)+1)*360 : XYZ(FR)=XYZ(FR)+ANG1
1742 '
1750 FOR J = 1 TO FRAME
1760 FOR L = 1 TO N+1
1770 θ = ANG1
1790 J1 = J
1800 ON FR GOSUB *X_CNV,*Y_CNV,*Z_CNV
1810 NEXT
1820 NEXT
1830 '
1832 XYZ$=""
1833 FOR L=1 TO 3
1834 XYZ$=XYZ$+","+STR$(XYZ(L)-((NOT XYZ(L)>360)+1)*360)
1835 NEXT
1836 SYMBOL (400,360),SUBM$(2),1,1,7 '現在の角度
1837 SYMBOL (400,376),XYZ$,1,1,7
1838 '
1840 FOR J = 1 TO FRAME
1850 FOR I = 1 TO N
1860 FOR L = 1 TO N
1870 LINE (X(I,J),Y(I,J))-(X(L,J),Y(L,J)),PSET,P '対角線を細く
1880 '
1890 'def pen 0,2
1900 LINE (X(L,J),Y(L,J))-(X(L+1,J),Y(L+1,J)),PSET,7 '枠組みを太く
1910 'def pen 0,1
1920 '
1930 NEXT
1931 NEXT
1940 NEXT
1950 '
1960 RETURN
1970 '
1980 *SAVE
1981 CLS 4
1990 LOCATE 3,23 : PRINT QUES$(8);
2000 INPUT "",S$
2010 IF S$ = "" THEN S$ = S1$
2020 IF S$ = "" THEN BEEP : GOTO 1990
2030 S1$ = S$
2040 SAVE@ S$+".tif",(0,0)-(400,400) 'セーブする
2050 '
2060 RETURN
2070 '
2080 *RESET
2090 CLS 4
2091 LOCATE 3,22 : PRINT QUES$(9);
2093 INPUT "",R$
2094 IF R$ = "N" OR R$ = "n" THEN *MAIN
2095 IF R$ = "Y" OR R$ = "y" THEN BEEP ELSE BEEP : GOTO *RESET
2096 RUN 'リセットする
2100 '
2110 *END
2120 CLS 4
2121 LOCATE 3,22 : PRINT QUES$(10);
2122 INPUT "",E$
2123 IF E$ = "N" OR E$ = "n" THEN *MAIN
2124 IF E$ = "Y" OR E$ = "y" THEN BEEP ELSE BEEP : GOTO *END
2125 END
2130 '
2140 *X_CNV
2150 GOSUB *CNV1
2160 GOSUB *MANUS
2170 θ = π*(θ/360*J)
2180 X1 = X
2190 Y1 = Z*SIN(θ)+Y*COS(θ)
2200 Z1 = Z*COS(θ)-Y*SIN(θ)
2210 GOSUB *PLUS
2220 GOSUB *CNV2
2230 RETURN
2240 '
2250 *Y_CNV
2260 GOSUB *CNV1
2270 GOSUB *MANUS
2280 θ = π*(θ/360*J)
2290 X1 = X*COS(θ)-Z*SIN(θ)
2300 Y1 = Y
2310 Z1 = X*SIN(θ)+Z*COS(θ)
2320 GOSUB *PLUS
2330 GOSUB *CNV2
2340 RETURN
2350 '
2360 '
2370 *Z_CNV
2380 GOSUB *CNV1
2390 GOSUB *MANUS
2400 θ = π*(θ/360*J)
2410 X1 = Y*SIN(θ)+X*COS(θ)
2420 Y1 = Y*COS(θ)-X*SIN(θ)
2430 Z1 = Z
2440 GOSUB *PLUS
2450 GOSUB *CNV2
2460 RETURN
2470 '
2480 *PLUS
2490 X1=X1+200
2500 Y1=Y1+200
2510 Z1=Z1+200
2520 RETURN
2530 '
2540 *MANUS
2550 X=X-200
2560 Y=Y-200
2570 Z=Z-200
2580 RETURN
2590 '
2600 *CNV1
2610 X=X(L,J)
2620 Y=Y(L,J)
2630 Z=Z(L,J)
2640 RETURN
2650 '
2660 *CNV2
2670 X(L,J1)=X1
2680 Y(L,J1)=Y1
2690 Z(L,J1)=Z1
2700 RETURN
2710 '
2720 *PF_KEYS
2730 FOR L = 1 TO K_KOSU
2740 'key設定
2750 SYMBOL (13*8*(L-1),25*16+54),"PF",1,1,4
2760 SYMBOL (13*8*(L-1)+1*8,25*16+54),STR$(L)+"-",1,1,4
2770 SYMBOL (13*8*(L-1)+5*8,25*16+54),K$(L),1,1,6
2780 NEXT
2790 RETURN
2800 '
2810 '▼▼▼▼▼▼▼▼▼▼▼DATA▼▼▼▼▼▼▼▼▼▼▼▼▼▼
2820 *ENGLISH'
2830 DATA "This program draws a figure which has as many apex as you like,"
2840 DATA "and draws diagonal lines in the color you like."
2850 DATA " (The number of '0' is black.)"
2860 DATA "If you hit ESC key, it stops making apex and diagonal lines."
2870 DATA "If you don't have any points to change, just hit RETURN key."
2880 DATA "Please command with the PFkeys."
2890 DATA "If you have read this explanation, please hit any key."
2900 DATA ""
2910 DATA "*Draw -PF1"
2920 DATA " It makes a new figure and clears the datas."
2930 DATA "*Spin -PF2"
2940 DATA " It spins the figure which was drawn around the frame of 'Y',"
2941 DATA " (It don't clear the last figure.)"
2950 DATA "*Change-PF3"
2960 DATA " It changes your point of view,"
2970 DATA " and spins as many angles as you like around what you like frame."
2980 DATA "*Save -PF4"
2990 DATA " It keeps the figure which was drawn."
2991 DATA " the kind of the data which was kept is 「.tif」file."
3000 DATA "*Reset -PF5"
3010 DATA " It resets this program."
3020 DATA "*End -PF6"
3030 DATA " It ends this program."
3040 DATA Eom
3050 DATA 6 'keyの個数
3060 DATA "Draw","Spin","Change","Save","Reset","End" 'keyの内容
3070 DATA "The number of apex is "
3071 DATA "The angl of X,Y,Z are " 'サブメッセージの内容
3080 '
3090 DATA 10 '質問の数
3100 DATA "What command do you give? >" '(main)
3110 DATA "What color in the diagonal lines (0-7)? >" '(spin)
3120 DATA "How many apex shall I draw (1-50)? >" '(spin)
3130 DATA "How many angle shall I spin ? >" '(spin)
3140 DATA "How many frames shall I draw ? >" '(spin)
3150 DATA "Waht frame shall I spin around ? >" '(change)
3160 DATA "How many angles shall I spin ? >" '(change)
3170 DATA "What name shall I keep this program as ? >" '(save)
3171 DATA "May I reset this program (Yes or No)? >" '(reset)
3180 DATA "May I end this program (Yes or No)? >" '(end)
3190 '
3200 *JAPANESE
3210 DATA " これはあなたの好きなように正多角形を作る物です。"
3220 DATA " また貴方の好きな色で対角線も作ります。"
3230 DATA " (0番は黒色です。)
3240 DATA " 図形を書いている時にESCキーを押すと書くのを止めます。"
3250 DATA " 前の場合と同じ時ははリターンキーを押してください。"
3260 DATA " PFキーで指令してください。"
3270 DATA " 読み終えたらリターンキーを押してください。"
3280 DATA ""
3281 '
3290 DATA "*新規作成-PF1"
3300 DATA " 新しく正多角形を作ります。その際に今までのデータ"
3301 DATA " ーは全て消去します。"
3310 DATA "*回転 -PF2"
3320 DATA " 今データーとしてある図形をY軸を中心にして回し"
3321 DATA " ます。(前に書かれた物は消しません。)"
3330 DATA "*移動 -PF3"
3340 DATA " いまデーターとしてある図形をY,X,Z軸を中心に"
3341 DATA " 回します。"
3350 DATA "*保存 -PF4"
3360 DATA " 今画面に書かれている図形を「.tif」の形で保存し"
3361 DATA " ます。"
3370 DATA "*リセット -PF5"
3380 DATA " このプログラムをリセットして初期状態に戻します。"
3390 DATA "*終了 -PF6"
3400 DATA " このプログラムを終了します。"
3410 DATA Eom
3420 DATA 6 'keyの個数
3430 DATA "新規作製","回転","移動","保存","リセット","終了" 'keyの内容
3440 DATA " 頂点の数は = "
3441 DATA "X,Y,Z軸の角度は = " 'サブメッセージの内容
3450 DATA 10
3460 DATA "何か指令してください >" '(メイン)
3470 DATA " 対角線は何色にしますか。 (0-7)? >" '(新規作成)
3480 DATA " 正何角形を作りますか。 (1-50)? >" '(新規作成)
3490 DATA " 何度回転させますか。? >" '(回転)
3500 DATA " 柱は何本にしますか。? >" '(回転)
3510 DATA " 何軸を中心にして回しますか。? >" '(移動)
3520 DATA " 何度回転させますか。? >" '(移動)
3530 DATA " 何と言う名前でこの図形を保存しますか。?" '(保存)
3540 DATA " リセットしていいでしょうか。(Yes or No)?" '(リセット)
3550 DATA " 終了していいでしょうか。 (Yes or No)? " '(リセット)